Amiga Plus 2002 #11/Amiga Plus CD - 2002 - No. 11.iso/Tools/Development/PowerD/alpha/source/dmod.d

Text File | 2002-10-28 | 14.1 KB | 604 lines

// view powerd binary module (#?.b) generated by powerd v0.12 and later

// 1.0 initial release
// 1.1 (27.1.2001)
//   added unions (in binary modules introduced with PowerD 0.17)
// 1.2 (29.12.2001)
//   added support for structs and cunions
//   improved object layout
// 1.3 (18.1.2002)
//   added support for multidimensional items in objects (introduced in dc 0.19alpha5)
//   added TDEF support
//   added OFFSET/RELOFS/ALIGN keywords support in OBJECTs

BYTE 0,0,'$VER:dmod v1.3 by MarK (\x4d)',0,0

PROC DisplayMODULE(mem:PTR TO CHAR)
  DEF ver,rev,count,nl,ml,namelist:PTR TO CHAR,type,flags,acount,rcount,l,offset,
      base:PTR TO CHAR

  IFN Long(mem)="DMOD"
    PrintF('\s: unknown filetype\n','dmod')
    RETURN
  ENDIF
  mem+=4            // skip "DMOD"
  ver:=Word(mem)
  rev:=Word(mem+2)
  mem+=4            // skip ver,rev
  PrintF('// required version of powerd: v\d.\z\d[2]\n\n',ver,rev)

  IF Long(mem)="MODS"
    PrintF('MODULE\t')
    count:=Word(mem+4)
    mem+=6
    WHILE count
      count--
      nl:=Word(mem)
      mem+=2
      PrintF('''\s''',mem)
      mem+=nl+1
      IF Odd(mem) THEN mem++
      IF CtrlC() THEN RETURN
    EXITIF count=0 DO PrintF('\n\n')
      PrintF(',\n\t\t\t')
    ENDWHILE
  ENDIF

  IF Long(mem)="CNST"       // constant list
    PrintF('CONST\t')
    count:=Word(mem+4)      // count of constants
    ml:=Long(mem+6)
    nl:=Long(mem+10)
    mem+=14
    namelist:=mem+ml
    WHILE count
      count--
      PrintF('\s=',namelist)
      type:=UByte(mem++)
      flags:=UByte(mem++)
      IF type=$ff
        PrintF('0')
      ELSEIF type=8       // DT_DOUBLE
        PrintF('$\z\h[8].\z\h[8]',Long(mem),Long(mem+4))
        mem+=8
      ELSEIF flags&%10      // S_TAG
        PrintF('$\h',Word(mem)|$80000000)
        mem+++
      ELSEIF type=3       // DT_WORD
        PrintF('\d',Word(mem))
        mem+++
      ELSE
        acount:=Long(mem)
        PrintF(IF acount>=-32768 AND acount<=32767 THEN '\d' ELSE '$\h',acount)
//        PrintF(IF Long(mem)>=-32768 AND Long(mem)<=32767 THEN '\d' ELSE '$\h',Long(mem))
        mem+=4
      ENDIF
      namelist+=StrLen(namelist)+1
      IF namelist[0]="\0" THEN namelist++
      IF CtrlC() THEN RETURN
    EXITIF count=0 DO PrintF('\n\n')
      PrintF(',\n\t\t')
    ENDWHILE
    IF Odd(namelist) THEN namelist++
    mem:=namelist
  ENDIF

  IF Long(mem)="OBJC"     -> object list
    ml:=Long(mem+4)
    nl:=Long(mem+8)
    acount:=Word(mem+12)
    count:=Word(mem+14)
    mem+=16
    namelist:=mem+ml
    offset:=0

    WHILE acount
      mem,namelist:=LoadOBJECT(mem,namelist,offset)
      acount--
      IF CtrlC() THEN RETURN
    ENDWHILE

    IF Odd(namelist) THEN namelist++
    mem:=namelist
  ENDIF

  IF Long(mem)="#def"     -> #define list
    count:=Word(mem+4)
    acount:=Word(mem+6)
    ml:=Long(mem+8)
    nl:=Long(mem+12)
    mem+=16
    namelist:=mem+ml

    WHILE count
      count--
      PrintF('#define \s',namelist)
      namelist+=mem[1]+1
      l:=Word(mem+2)
      acount:=mem[0]
      mem+=4
      IF acount
        PrintF('(')
        WHILE acount
          PrintF('\s',namelist)
          namelist+=mem[1]+1
          mem+++
          acount--
          IF CtrlC() THEN RETURN
        EXITIF acount=0 DO PrintF(') ')
          PrintF(',')
        ENDWHILE
      ELSE PrintF(' ')
      PrintF('\s\n',namelist)
      namelist+=l+1
      IF CtrlC() THEN RETURN
    ENDWHILE

    IF Odd(namelist) THEN namelist++
    mem:=mem+nl
  ENDIF

  IF Long(mem)="LIBR"     // function list
    count:=Word(mem+4)    // count of functions
    nl:=Word(mem+6)     // base name length
    ml:=Long(mem+12)      // block length
    mem+=16
    base:=mem
    mem+=nl
    IF mem[0]="\0" THEN mem++
    namelist:=mem+ml
    PrintF('LIBRARY \s\n\t',base)

    WHILE count
      count--
      offset:=Word(mem)
      acount:=mem[2]
      rcount:=mem[3]&$1f
      ver:=mem[3]>>5      // get ppc function type
      SELECT ver
      CASE 0; PrintF('M68K,')
      CASE 1; PrintF('PPC,')
      CASE 2; PrintF('PPC2,')
      CASE 3; PrintF('PPC0,')
      ENDSELECT
      mem+=4
      PrintF('\s(',namelist)
      namelist+=StrLen(namelist)+1
      WHILE acount
        acount--
        IF ver
          SELECT mem[2]
          CASE 0 TO 31; PrintF('r\d',mem[2]&%11111)
          CASE 32 TO 63;  PrintF('f\d',mem[2]&%11111)
          ENDSELECT
        ELSE
          SELECT mem[2]
          CASE 0 TO 7;  PrintF('d\d',mem[2]&%111)
          CASE 8 TO 15; PrintF('a\d',mem[2]&%111)
          CASE 16 TO 23;  PrintF('fp\d',mem[2]&%111)
          ENDSELECT
        ENDIF
        type:=mem[0]
        flags:=mem[1]   // means default value set
        nl:=mem[3]
        mem+=4
        IF flags
          IF type=8
            PrintF('=$\z\h[8].\z\h[8]',Long(mem),Long(mem+4))
            mem+=8
          ELSE
            PrintF('=$\d',Long(mem))
            mem+=4
          ENDIF
        ENDIF
        IF type
          PrintF(':\s',TypeStr(type))
        ENDIF
        IF nl
          PrintF('\s',namelist)
          namelist+=nl+1
        ENDIF
      EXITIF acount=0
        PrintF(',')
        IF CtrlC() THEN RETURN
      ENDWHILE
      PrintF(')')

      IF rcount
        PrintF('(')
        WHILE rcount
          rcount--
          IF ver
            SELECT mem[2]
            CASE 0 TO 31; PrintF('r\d',mem[2]&%11111)
            CASE 32 TO 63;  PrintF('f\d',mem[2]&%11111)
            ENDSELECT
          ELSE
            SELECT mem[2]
            CASE 0 TO 7;  PrintF('d\d',mem[2]&%111)
            CASE 8 TO 15; PrintF('a\d',mem[2]&%111)
            CASE 16 TO 23;  PrintF('fp\d',mem[2]&%111)
            ENDSELECT
          ENDIF
          type:=mem[0]
          nl:=mem[3]
          mem+=4
          IF type
            PrintF(':\s',TypeStr(type))
          ENDIF
          IF nl
            PrintF('\s',namelist)
            namelist+=nl+1
          ENDIF
        EXITIF rcount=0 DO PrintF(')')
          PrintF(',')
          IF CtrlC() THEN RETURN
        ENDWHILE
      ENDIF
      PrintF('=\d',offset)
      IF CtrlC() THEN RETURN
    EXITIF count=0 DO PrintF('\n\n')
      PrintF(',\n\t')
    ENDWHILE
    IF Odd(namelist) THEN namelist++
    mem:=namelist
  ENDIF

  IF Long(mem)="EXPR"     // external function list
    count:=Word(mem+4)
    ml:=Long(mem+10)
    nl:=Long(mem+14)
    mem+=18
    namelist:=mem+ml

    WHILE count
      count--
      SELECT type:=mem[0]
      CASE 11;  PrintF('EPROC')
      CASE 13;  PrintF('LPROC')
      CASE 14;  PrintF('RPROC')
      ENDSELECT
/*
      IF StrCmp(namelist,'Ror')
        xxxxxx:
        l:=l
      ENDIF
*/
      PrintF(' \s(',namelist)
      namelist+=StrLen(namelist)+1
      flags:=mem[1]
      acount:=mem[2]
      rcount:=mem[3]
      mem+=4
      offset:=0
      IF flags&%01
        offset:=namelist
        namelist+=StrLen(namelist)+1
      ENDIF

      IF type=14
        IF flags&%10
          l:=namelist
          namelist+=StrLen(namelist)+1
        ELSE
          l:=NIL
        ENDIF
      ENDIF

      WHILE acount
        acount--
        type:=mem[0]
        flags:=mem[1]
        SELECT mem[3]
        CASE 0 TO 7;  PrintF('d\d',mem[3]&%111)
        CASE 8 TO 15; PrintF('a\d',mem[3]&%111)
        CASE 16 TO 23;  PrintF('fp\d',mem[3]&%111)
        DEFAULT;      PrintF('\c',"z"-acount)   // stack
        ENDSELECT
        mem+=4
        IF flags&%01
          IF type=8 // DT_DOUBLE
            PrintF('=$\z\h[8].\z\h[8]',Long(mem),Long(mem+4))
            mem+=8
          ELSE
            PrintF('=\d',Long(mem))
            mem+=4
          ENDIF
        ENDIF
        IF type
          PrintF(':\s',TypeStr(type))
          IF flags&%10
            PrintF('\s',namelist)
            namelist+=StrLen(namelist)+1
          ENDIF
        ENDIF
      EXITIF acount=0
        PrintF(',')
        IF CtrlC() THEN RETURN
      ENDWHILE
      PrintF(')')

      IF rcount
        PrintF('(')
        WHILE rcount
          rcount--
          type:=mem[0]
          SELECT mem[1]
          CASE 0 TO 7;  PrintF('d\d',mem[1]&%111)
          CASE 8 TO 15; PrintF('a\d',mem[1]&%111)
          CASE 16 TO 23;  PrintF('fp\d',mem[1]&%111)
          ENDSELECT
          mem+++
          IF type THEN PrintF(':\s',TypeStr(type))
          IF type=10 OR type=42 OR type=74 OR type=138
            PrintF('\s',namelist)
            namelist+=StrLen(namelist)+1
          ENDIF
        EXITIF rcount=0 DO PrintF(')')
          PrintF(',')
          IF CtrlC() THEN RETURN
        ENDWHILE
      ENDIF

      IF offset THEN PrintF(' OF \s',offset)
      IF l THEN PrintF('=''\s''',l)
      IF CtrlC() THEN RETURN
      PrintF('\n')
    ENDWHILE
    PrintF('\n')
    IF Odd(namelist) THEN namelist++
    mem+=nl
  ENDIF

  IF Long(mem)="EDEF"
    PrintF('EDEF\t')
    count:=Word(mem+4)
    ml:=Long(mem+6)
    nl:=Long(mem+10)
    mem+=14
    namelist:=mem+ml

    WHILE count
      count--
      PrintF('\s',namelist)
      namelist+=StrLen(namelist)+1
      IF mem[0] THEN PrintF(':\s',TypeStr(mem[0]))
      IF mem[1]
        PrintF('\s',namelist)
        namelist+=StrLen(namelist)+1
      ENDIF
      mem+++
    EXITIF count=0 DO PrintF('\n\n')
      PrintF(',\n\t\t')
      IF CtrlC() THEN RETURN
    ENDWHILE
    mem+=nl
  ENDIF

  IF Long(mem)="LINK"
    PrintF('OPT\t')
    count:=Word(mem+4)
    mem:=mem+6
    WHILE count
      count--
      nl:=Word(mem)
      mem+++
      PrintF('''\s''',mem)
      mem:=mem+nl
      IF Odd(nl) THEN mem++
    EXITIF count=0 DO PrintF('\n')
      PrintF(',\n\t\t')
      IF CtrlC() THEN RETURN
    ENDWHILE
  ENDIF

  IF Long(mem)="HEAD"
    nl:=Word(mem+4)
    mem+=6
    PrintF('OPT\tHEAD=''\s''\n',mem)
    mem+=nl
    IF Odd(nl) THEN mem++
  ENDIF

  IF Long(mem)="TDEF"
    PrintF('TDEF\t')
    count:=Word(mem+4)
    ml:=Long(mem+6)
    nl:=Long(mem+10)
    mem:=mem+14
    namelist:=mem+ml
    WHILE count
      PrintF('\s:\s',namelist,TypeStr(mem[0]))
      namelist+=mem[1]+1
      IF mem[2]
        PrintF(' \s',namelist)
        namelist+=mem[2]+1
      ENDIF
      mem+=4
      count--
      IF count THEN PrintF(',\n\t\t') ELSE PrintF('\n\n')
      IF CtrlC() THEN RETURN
    ENDWHILE
    mem+=nl
    IF Odd(mem) THEN mem++
  ENDIF

ENDPROC

PROC LoadOBJECT(mem:PTR TO CHAR,nmem:PTR TO CHAR,offset,depth=0)(PTR TO CHAR,PTR TO CHAR)
  DEF count
  IF mem[0]=0   // next object
    do_depth
    PrintF('OBJECT \s',nmem)
    nmem+=mem[1]+1
    IF mem[2]
      PrintF(' OF \s\n',nmem)
      nmem+=mem[2]+1
    ELSE PrintF('\n')
    mem+=8
    WHILE mem[0]>=1 AND mem[0]<=5
      mem,nmem:=LoadOBJECT(mem,nmem,offset,depth+1)
    ELSEWHILE mem[0]>=6 AND mem[0]<=8
      mem,nmem:=LoadOBJECT(mem,nmem,offset,depth)
    ALWAYS
    EXITIF mem[0]<1 AND mem[0]>8 DO PrintF('\n\n')
      PrintF(',\n')
      IF CtrlC() THEN RETURN
    ENDWHILE
  ELSEIF mem[0]=1 // normal item
    do_depth
    PrintF('\s',nmem)
    nmem+=mem[1]+1
    IF Word(mem+6) THEN PrintF('[\d]',Word(mem+6))
    PrintF(':\s',TypeStr(mem[2]))
    IF mem[5]
      PrintF('\s',nmem)
      nmem+=mem[5]+1
    ENDIF
    mem+=10
  ELSEIF mem[0]=5 // normal multidimensional item
    do_depth
    PrintF('\s',nmem)
    nmem+=mem[1]+1
    IF Word(mem+6)
      PrintF('[\d',Word(mem+6))
      IF Word(mem+10)
        PrintF(',\d',Word(mem+10))
        IF Word(mem+12)
          PrintF(',\d]',Word(mem+12))
        ELSE PrintF(']')
      ELSE PrintF(']')
    ENDIF
    PrintF(':\s',TypeStr(mem[2]))
    IF mem[5]
      PrintF('\s',nmem)
      nmem+=mem[5]+1
    ENDIF
    mem+=14
  ELSEIF mem[0]=2 // union/object
    DEF first=TRUE
    WHILE mem[0]=2
      do_depth
      PrintF('\s \s\n',IF first THEN 'OBJECT' ELSE 'UNION',nmem)
      nmem+=mem[1]+1
      count:=mem[2]
      mem+=6
      WHILE count
        count--
        mem,nmem:=LoadOBJECT(mem,nmem,offset,depth+1)
        PrintF(IF (mem[0]=1 OR mem[0]=3) AND count>0 THEN ',\n' ELSE '\n')
        IF CtrlC() THEN RETURN
      ENDWHILE
      first:=FALSE
    ENDWHILE
    PrintF('\tENDOBJECT')
  ELSEIF mem[0]=3 // struct
    do_depth
    DEF name
    count:=mem[2]
    offset:=Word(mem+4)
    name:=nmem
    nmem+=mem[1]+1
    mem+=6
    PrintF('[\n')
    WHILE count
      count--
      mem,nmem:=LoadOBJECT(mem,nmem,offset,depth+1)
      PrintF(IF count>0 THEN ',\n' ELSE '\n')
      IF CtrlC() THEN RETURN
    ENDWHILE
    do_depth
    PrintF(']:\s',name)
  ELSEIF mem[0]=4 // cunion
    count:=mem[1]
    mem+=4
    do_depth
    PrintF('CUNION\n')
    WHILE count
      count--
      mem,nmem:=LoadOBJECT(mem,nmem,offset,depth+1)
      PrintF(IF count>0 THEN ',\n' ELSE '\n')
      IF CtrlC() THEN RETURN
    ENDWHILE
    PrintF('\tENDUNION')
  ELSEIF mem[0]=6 // offset
    do_depth
    PrintF('OFFSET \d',Word(mem+2))
    mem+=4
  ELSEIF mem[0]=7 // relofs
    do_depth
    PrintF('RELOFS \d',Word(mem+2))
    mem+=4
  ELSEIF mem[0]=8 // offset
    do_depth
    IF Word(mem+2)=4
      PrintF('ALIGN')
    ELSE
      PrintF('ALIGN \d',Word(mem+2))
    ENDIF
    mem+=4
  ELSE
  ENDIF
  SUB do_depth
    DEF dp=depth
    WHILE dp-- DO PrintF('\t')
  ENDSUB
ENDPROC mem,nmem

PROC TypeStr(type)(PTR TO CHAR)
  DEF str2:PTR TO CHAR,cnt,str:PTR TO CHAR
  str2:='                                                                            '
  str2[0]:="\0"
  cnt:=(type & %11100000)>>5  // obtain the pointer count from the type
  IF cnt>4 THEN cnt--     // here we have to skip the DT_LIST type

  SELECT type&%00011111
  CASE 1; str:='LONG'
  CASE 2; str:='ULONG'
  CASE 3; str:='WORD'
  CASE 4; str:='UWORD'
  CASE 5; str:='BYTE'
  CASE 6; str:='UBYTE'
  CASE 7; str:='FLOAT'
  CASE 8; str:='DOUBLE'
  CASE 9; str:='BOOL'
  CASE 10;  str:='\0'
  CASE 11;  str:='PTR'
  CASE 12;  str:='DLONG'
  CASE 13;  str:='UDLONG'
  CASE 14;  str:=IF type&%11100000 THEN 'CHAR' ELSE 'STRING'
  DEFAULT;  str:='VOID'
  ENDSELECT

  IF (type&%11100000)=%10000000
    StrCopy(str2,'LIST OF ')
  ELSE
    WHILE cnt
      StrAdd(str2,'PTR TO ')
      cnt--
    ENDWHILE
  ENDIF
  StrAdd(str2,str)
ENDPROC str2

MODULE  'exec/memory'

ENUM  SOURCE

PROC main()
  DEF rda,args=[0,0]:LONG,l,m:PTR TO CHAR,f
  IF rda:=ReadArgs('SOURCE/A',args,NIL)
    l:=FileLength(args[SOURCE])
    IF f:=Open(args[SOURCE],OLDFILE)
      IF m:=AllocMem(l+8,MEMF_PUBLIC|MEMF_CLEAR)
        IF Read(f,m,l)=l
          DisplayMODULE(m)
        ELSE PrintFault(IOErr(),'dmod')
        FreeMem(m,l+8)
      ELSE PrintF('\s: not enough memory\n','dmod')
      Close(f)
    ELSE PrintFault(IOErr(),'dmod')
    FreeArgs(rda)
  ELSE PrintFault(IOErr(),'dmod')
ENDPROC